Análisis de Twitter en periodos de emergencia: Sismo 19 del septiembre del 2017, CDMX

1. Introducción

Las redes sociales en periodos de emergencia ha incrementado su importancia por la rapidez de la comunicación y el alcance que tienen. Una de las redes sociales que más presencia tiene en este ámbito, es Twitter, debido a que la mayoría de entidades gubernamentales tienen una cuenta oficial por la cuál realizan comunicados.

El análisis del comportamiento en redes sociales como Twitter puede realizarse de varias maneras. Una es estudiando las relaciones entre los diferentes usuarios para ver la importancia que tiene como usuario para comunicar a la comunidad en general. Otra forma de analizar este comportamiento, es analizando el contenido del mismo texto para ver el tipo de mensajes que la gente está transmitiendo, si son similares o difiren mucho entre ellos.

Estas herramientas nos pueden ayudar a entender de manera amplia, el comportamiento de las personas en dicha red social, sobre todo en periodos de emergencia donde en crucial estar atentos a información oficial y verídica.

1.1. Objetivo

El objetivo del presente trabajo, es estudiar el comportamiento de la sociedad a través de la red social Twitter en un evento en específico como sismo del 19 de septiembre del 2017 en la Ciudad de México. Este estudio se realizará con herramientas de análisis de texto, Locality Sensitive Hashing y análisis de redes.

1.2. Metodología

Se realizó un scrapping de tweets desde la API de Twitter, obteniendo tokens y llaves secretas para acceder como investigador académico y así poder obtener tweets históricos con el endpoint: "https://api.twitter.com/2/tweets/search/all"

Se descargaron alrededor de 80,000 tweets de los cuáles se obtuvimos 65,489 tweets con clave única, incluyendo retweets. Los datos extraídos son del 11 de septiembre de 2017 al 31 de diciembre de 2017; utilizando como referencia de palabras "sismo cdmx", "#MexicoNosNecesita", "ayuda sismo" y "19s".

El contenido de la base tiene las siguientes columnas:

created_at: la fecha en la que se publicó el tweet.
id: ID único del tweet.
author_id: ID del usuario del tweet.
reply_to_user_id: diccionario del tipo de tweet (si fue retweet) y del ID del usuario a quien hizo retweet.
entities: diccionario de nombres de usuario, hashtags y URLs mencionados en el tweet.
text: texto del tweet.
username: nombre de usuario que publicó el tweet.

2. Limpieza y análisis de texto

Antes de iniciar cualquier tipo de análisis decidimos limpiar el texto del tweet y agregar dos columnas para que el análisis de redes fuera más sencillo de realizar, las cuales fueron: nombre de usuario a quien se le hizo retweet y nombres de usuarios mencionados en el tweet. En las tareas de limpieza y agregado de columnas se utilizaron expresiones regulares.

Iniciamos con la agregación de columnas:

Nombre de usuario del retweet: Se obtuvo a partir del tweet extrayendo el usuario mencionado cuando existía "RT @" en el tweet.
Nombres de usuarios mencionados: Se obtuvieron todas las menciones en el tweet y se remueve el nombre de usuario del retweet si existe.

Posteriormente, realizamos la limpieza del texto del tweet donde las tareas fueron las siguientes:

Remover:
Acentos
Caracteres especiales como "’"?¡!*,.():;-_¿", a
La secuencia "RT" haciendo referencia al retweet
Menciones de usuarios
URLs especificadas como www. o https:
Espacios extras

3. Minhashing - Locality Sensitive Hashing

El objetivo de utilizar Locality Sensitive Hashing (LSH) en este proyecto, es agrupar colecciones de los tweets obtenidos que tienen alta similitud. Construimos el LSH basándonos en las firmas de minhash, y así asignar el documento en una cubeta dependiendo de ésta.

Empezemos el análisis de tweets incluyendo retweets:

#tweets <- read_csv('../data/tweets_limpios_2021_05_15.csv')
tweets <- read.csv('/Volumes/MemoriaEle/HeavyData/tweets_sismo/tweets_limpios_2021_05_12.csv')
tweets_texto <- tweets$texto_limpio

Creamos el hash (la firma) a partir de las tejas, de las cuales se ha decidido utilizar 6 caracteres para crear las tejas y así mapear cada teja a un entero.

set.seed(20210512)
hash_f <- map(1:12, ~ generar_hash())
tejas_tbl <- crear_tejas_str(tweets_texto, k = 6)
firmas_tw <- calcular_firmas_doc(tejas_tbl, hash_f)

Una vez obtenida la firma de cada documento y creamos una cubeta para cada firma diferente, las firmas que se encuentran en la misma cubeta son documentos candidatos a ser similares. Se ha decidido capturar pares de documentos con similitud más baja y así agrupar textos con algún grupo de 7 minhashes iguales.

particion <- split(1:12, ceiling(1:12 / 7))
sep_cubetas <- separar_cubetas_fun(particion) 
#sep_cubetas(firmas_tw$firma[[1]])
cubetas_tbl <- firmas_tw %>%
    mutate(cubeta = map(firma, sep_cubetas)) %>%
    unnest_legacy(cubeta) %>% 
    group_by(cubeta) %>% 
    summarise(docs = list(doc_id), n = length(doc_id)) %>%
    arrange(desc(n))

# % de cubetas con documentos únicos
nrow(cubetas_tbl %>% filter(., n==1)) / nrow(cubetas_tbl) * 100

## [1] 61.17217

cubetas_tbl %>% arrange(desc(n)) %>% head(10)

## # A tibble: 10 x 3
##    cubeta                                                       docs           n
##    <chr>                                                        <list>     <int>
##  1 1234567|-2008775215/-2122151675/-2122090398/-2117169247/-20… <int [2,3…  2333
##  2 89101112|-2137691784/-2136477889/-2100372949/-2137832391/-2… <int [2,3…  2332
##  3 1234567|-2136053538/-2138130124/-2128531355/-2115882046/-21… <int [900…   900
##  4 89101112|-2087827927/-2137492721/-2139989256/-2120715613/-2… <int [900…   900
##  5 89101112|-2091281108/-2091629007/-2067551643/-2116874230/-2… <int [790…   790
##  6 1234567|-2112303824/-2066641891/-2083428520/-2133744416/-21… <int [789…   789
##  7 1234567|-2129159949/-2123593520/-2141541158/-2094788425/-21… <int [575…   575
##  8 89101112|-2123549595/-2126511326/-2125935857/-2125960001/-2… <int [575…   575
##  9 89101112|-2003178593/-2119913915/-2100372949/-2129757345/-2… <int [453…   453
## 10 1234567|-2054212836/-2113394369/-2147476307/-2078766204/-21… <int [450…   450

En la tabla anterior podemos observar que obtuvimos 25,957 cubetas de las cuales la más grande contiene 2,333 documentos, esto nos indica que tenemos muchos tweets parecidos o iguales. Si hacemos un análisis básico , véase la siguiente gráfica, podemos obtener que aproximadamente el 60% de nuestras cubetas contienen un único documentos, por lo que podemos suponer que el 60% de los usuarios hablan de tópicos diferentes acerca del sismo del 2017 y el 40% restante son retweets o copias de los tweets.

# filtramos las cubetas que tienen menos de 10 documentos para ejercicio visual de la gráfica
cubetas_tbl_2 <- filter(cubetas_tbl, n>10)

ggplot() + 
  geom_line(data=cubetas_tbl_2, aes(x=as.numeric(row.names(cubetas_tbl_2)), y=n), color="#10D6C1") + 
  labs(title="No. de documentos por cubeta", y="no. de documentos", x="id cubeta")

Como vimos que aproximadamente el 40% de nuestros datos son retweets y no pudimos obtener mucha información de este análisis; por lo que se ha realizado el mismo proceso pero removiendo los tweets duplicados; de 65,489 tweets nos quedaron 15,101.

tw_hashes <- digest::digest2int(tweets_texto)
tw_dedup <- tibble(tweet = tweets_texto, hash = tw_hashes) %>% 
  group_by(hash) %>% 
  summarise(tweet = tweet[1], .groups = "drop") %>%  
  mutate(longitud = nchar(tweet)) %>% 
  filter(longitud >= 5) %>% # Quitamos los tweets con 5 caracteres
  pull(tweet)

tw_dedup_2 <- tibble(tweet = tweets_texto, usuario=tweets$username, hash = tw_hashes) %>% 
  group_by(hash) %>% 
  summarise(tweet = tweet[1], usuario=usuario[1], .groups = "drop") %>%  
  mutate(longitud = nchar(tweet)) %>% 
  filter(longitud >= 5) %>% 
  pull(tweet, usuario)

length(tweets_texto)

## [1] 65489

length(tw_dedup)

## [1] 16426

Repetimos el mismo proceso realizado anteriormente para crear los hashes a partir de las tejas y separar por cubetas.

set.seed(20210512)
hash_f <- map(1:12, ~ generar_hash())
tejas_tbl <- crear_tejas_str(tw_dedup, k = 6)
firmas_tw <- calcular_firmas_doc(tejas_tbl, hash_f)
particion <- split(1:12, ceiling(1:12 / 7))
sep_cubetas <- separar_cubetas_fun(particion) 
#sep_cubetas(firmas_tw$firma[[1]])
cubetas_tbl <- firmas_tw %>%
    mutate(cubeta = map(firma, sep_cubetas)) %>%
    unnest_legacy(cubeta) %>% 
    group_by(cubeta) %>% 
    summarise(docs = list(doc_id), n = length(doc_id)) %>%
    arrange(desc(n))

# % de cubetas con documentos únicos
nrow(cubetas_tbl %>% filter(., n==1)) / nrow(cubetas_tbl) * 100

## [1] 87.96625

cubetas_tbl %>% arrange(desc(n)) %>% head(10)

## # A tibble: 10 x 3
##    cubeta                                                         docs         n
##    <chr>                                                          <list>   <int>
##  1 89101112|-2131522090/-2144189590/-2117844523/-2038592300/-211… <int [3…    35
##  2 89101112|-2066900694/-2135681430/-2090886691/-2134379319/-212… <int [1…    17
##  3 89101112|-2139787922/-2133256811/-2082685657/-2137168907/-210… <int [1…    14
##  4 89101112|-2030500011/-2137673452/-2138055856/-2088010830/-212… <int [1…    13
##  5 89101112|-2069141510/-2062136830/-2079119996/-2137168907/-196… <int [1…    13
##  6 1234567|-2134136993/-2119814932/-2117161379/-2143333928/-2129… <int [1…    11
##  7 89101112|-2140013388/-2134173991/-2147175053/-2136151037/-214… <int [1…    11
##  8 89101112|-2141593581/-2123994064/-2140676212/-2124800585/-208… <int [1…    11
##  9 1234567|-2120063705/-2094940020/-2123090475/-2146625593/-2102… <int [1…    10
## 10 1234567|-2126465528/-2108889792/-2098641846/-2139334208/-2122… <int [1…    10

En la tabla anterior, podemos observar que mantuvimos las 25,957 cubetas pero el número de documentos por cubeta bajó y ahora el máximo de documentos en una cubeta es de 25 documentos. Y esta vez obtenemos un aproximado del 90% de cubetas con un documento único.

# filtramos las cubetas que tienen menos de 2 documentos para ejercicio visual de la gráfica
cubetas_tbl_2 <- filter(cubetas_tbl, n>2)

ggplot() + 
  geom_line(data=cubetas_tbl_2, aes(x=as.numeric(row.names(cubetas_tbl_2)), y=n), color="#10D6C1") + 
  labs(title="No. de documentos por cubeta", y="no. de documentos", x="id cubeta")

Si evaluamos una cubeta con varios documentos, por ejemplo la segunda cubeta, podemos observar que los textos a pesar de que tienen diferentes cifras el contenido es muy parecido y hace referencia a albergues donde pernoctaron las personas tras el sismo.

DT::datatable(cubetas_tbl$docs[[2]] %>% data.frame(tweet=tw_dedup[.],usuario=attr(tw_dedup_2[.],'names')))

Una vez obteniendo las cubetas podemos encontrar eficientemente los pares de similitud alta; ya que sólo se hará la evualación en los pares de documentos dentro de cada cubeta y se podrán filtrar los documentos en los que tengan menor a 30% de similitud.

# Filtramos las cubetas en donde se pueden hacer pares
cubetas_nu_tbl <- filter(cubetas_tbl, n > 2)

# Agregar extracción de usuario a y usuario b
pares_candidatos <- extraer_pares(cubetas_nu_tbl, cubeta, docs, textos = tw_dedup, names=attr(tw_dedup_2, 'names')) %>% 
                  arrange(texto_a)

pares_scores <- pares_candidatos %>% 
  mutate(score = map2_dbl(texto_a, texto_b,
  ~ sim_jaccard(calcular_tejas(.x, 5), calcular_tejas(.y, 5)))) %>% arrange(desc(score))  %>% filter(score > 0.3)
DT::datatable(pares_scores)

Dado que en este análisis encontramos que muchos usuarios hacen retweet más que tener texto único, se optó por realizar un análisis con redes que en breve explicaremos.

4. Análisis de Redes

Para hacer el análisis de redes del presente trabajo, utilizamos:

Los usuarios propietarios del tweet.
Los usuarios que fueron mencionados en el tweet.
Los usuarios que fueron retuiteados.

Es decir, tenemos dos redes dirigidas una que va del usuario propietario al usuario mencionado, y otra que va del usuario propietario al usuario que retuitea.

Red dirigida de menciones

Nodos: 12,011
Aristas: 25,060

Construimos la red:

# tbl_graph identifica los nodos y los vertices
users_nodes_edges <- usuarios %>% as_tbl_graph()
users_nodes_edges

## # A tbl_graph: 12011 nodes and 25063 edges
## #
## # A directed multigraph with 430 components
## #
## # Node Data: 12,011 x 1 (active)
##   name           
##   <chr>          
## 1 loreCM505      
## 2 kisshoeo       
## 3 MulitoreR      
## 4 EstelaA96215253
## 5 pelandrufo68   
## 6 ssn_mx         
## # … with 12,005 more rows
## #
## # Edge Data: 25,063 x 2
##    from    to
##   <int> <int>
## 1     1  9881
## 2     1     1
## 3     1  9882
## # … with 25,060 more rows

# obtenemos los vertices
vertices_users <- users_nodes_edges %>% 
  activate(edges) %>% 
  select(to, from) %>% 
  as_tibble()

# agregamos los vertices por frecuencia
vertices_agregados_users <- vertices_users %>% 
  group_by(to, from) %>% 
  summarise(freq_vert = n())

Observamos un histograma de las aristas más repetidas, filtrando desde 5 para arriba. En esta figura observamos que la frecuencia de aristas con menciones menores a 10, son muy grandes, por lo que utilizamos un filtro de menciones arriba de dicho número, para evitar tener conexiones con poca cantidad de menciones.

# obtenemos solo los nodos 
nodos_users <- users_nodes_edges %>% 
  activate(nodes) %>% 
  as_tibble() 
nodos_users

## # A tibble: 12,011 x 1
##    name           
##    <chr>          
##  1 loreCM505      
##  2 kisshoeo       
##  3 MulitoreR      
##  4 EstelaA96215253
##  5 pelandrufo68   
##  6 ssn_mx         
##  7 dolorojas      
##  8 arelibiciteka  
##  9 Balanzariov    
## 10 reformaciudad  
## # … with 12,001 more rows

# volvemos a armar la red
users_nodes_edges_2 <- tbl_graph(
  nodes = nodos_users, 
  edges = vertices_agregados_users) 
users_nodes_edges_2

## # A tbl_graph: 12011 nodes and 20348 edges
## #
## # A directed multigraph with 430 components
## #
## # Node Data: 12,011 x 1 (active)
##   name           
##   <chr>          
## 1 loreCM505      
## 2 kisshoeo       
## 3 MulitoreR      
## 4 EstelaA96215253
## 5 pelandrufo68   
## 6 ssn_mx         
## # … with 12,005 more rows
## #
## # Edge Data: 20,348 x 3
##    from    to freq_vert
##   <int> <int>     <int>
## 1     1     1         1
## 2    18     1         1
## 3    66     1         1
## # … with 20,345 more rows

# filtramos para los que tienen más frecuencia
corte_freq_vert <- 10
users_grandes <- users_nodes_edges_2 %>% 
  activate(edges) %>% 
  filter(freq_vert > corte_freq_vert) %>% 
  activate(nodes) %>% 
  filter(!node_is_isolated())

La siguiente figura es una representación de la red que muestra las conecciones entre los nodos.

Ahora obtenemos la medida de intermediación:

# Componentes
compo_users <-  users_grandes %>% 
  activate(nodes) %>% 
  mutate(componente = group_components())

compo_users %>% 
  as_tibble %>% 
  group_by(componente) %>% 
  tally()

## # A tibble: 7 x 2
##   componente     n
##        <int> <int>
## 1          1    65
## 2          2     4
## 3          3     3
## 4          4     3
## 5          5     2
## 6          6     1
## 7          7     1

# filtramos por componente conexa más grande
usi <- users_grandes %>% 
  activate(nodes) %>% 
  mutate(componente = group_components()) %>% 
  filter(componente == 1)

# Calculamos la intermediación
usi <- usi %>% activate(nodes) %>% 
  mutate(intermediacion = centrality_betweenness())

La siguiente figura presenta la red tomando en cuenta la medida de intermediación, que recordemos que nos proporciona una medida indicando qué tan único o importante es un nodo para conectar con otros nodos en la red.

Medida de centralidad de eigenvector.

usi <- usi %>%
  activate(nodes) %>% 
  mutate(central_eigen = centrality_eigen())

Red dirigida de retweets

Nodos:
Aristas: